home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / a_utils / yacc / flexyacc / aflex.lha / aflex / src / ascan.l < prev    next >
Text File  |  1992-12-29  |  13KB  |  526 lines
  1. -- Copyright (c) 1990 Regents of the University of California.
  2. -- All rights reserved.
  3. --
  4. -- This software was developed by John Self of the Arcadia project
  5. -- at the University of California, Irvine.
  6. --
  7. -- Redistribution and use in source and binary forms are permitted
  8. -- provided that the above copyright notice and this paragraph are
  9. -- duplicated in all such forms and that any documentation,
  10. -- advertising materials, and other materials related to such
  11. -- distribution and use acknowledge that the software was developed
  12. -- by the University of California, Irvine.  The name of the
  13. -- University may not be used to endorse or promote products derived
  14. -- from this software without specific prior written permission.
  15. -- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
  16. -- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
  17. -- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  18.  
  19. -- TITLE scanner specification file
  20. -- AUTHOR: John Self (UCI)
  21. -- DESCRIPTION regular expressions and actions matching tokens
  22. --             that aflex expects to find in its input.
  23. -- NOTES input to aflex (NOT alex.)  It uses exclusive start conditions
  24. --       and case insensitive scanner generation available only in aflex
  25. --       (or flex if you use C.)
  26. --       generate scanner using the command 'aflex -is ascan.l'
  27. -- $Header: /dc/uc/self/arcadia/aflex/ada/src/RCS/ascan.l,v 1.19 1991/12/03 23:08:24 self Exp self $ 
  28.  
  29. %x SECT2 SECT2PROLOG SECT3 PICKUPDEF SC CARETISBOL NUM QUOTE
  30. %x FIRSTCCL CCL ACTION RECOVER BRACEERROR
  31. %x ACTION_STRING
  32.  
  33. WS        [ \t\f]+
  34. OPTWS        [ \t\f]*
  35. NOT_WS        [^ \t\f\n]
  36.  
  37. NAME        [a-z_][a-z_0-9-]*
  38. NOT_NAME    [^a-z_\n]+
  39.  
  40. SCNAME        {NAME}
  41.  
  42. ESCSEQ        \\([^\n]|[0-9]{1,3})
  43.  
  44. %%
  45.  
  46. ^{WS}            { indented_code := true; }
  47. ^#.*\n            { linenum := linenum + 1; ECHO;
  48.                 -- treat as a comment;
  49.             }
  50. ^{OPTWS}"--".*\n    { linenum := linenum + 1; ECHO; }
  51. ^"%s"(tart)?        { return ( SCDECL ); }
  52. ^"%x"            { return ( XSCDECL ); }
  53.  
  54. {WS}            { return ( WHITESPACE ); }
  55.  
  56. ^"%%".*            {
  57.             sectnum := 2;
  58.             misc.line_directive_out;
  59.             ENTER(SECT2PROLOG);
  60.             return ( SECTEND );
  61.             }
  62.  
  63. ^"%"[^%sx]" ".*\n        {
  64.             text_io.put( Standard_Error, "old-style lex command at line " );
  65.             int_io.put( Standard_Error, linenum );
  66.             text_io.put( Standard_Error, "ignored:" );
  67.             text_io.new_line( Standard_Error );
  68.             text_io.put( Standard_Error, ASCII.HT );
  69.             text_io.put( Standard_Error, yytext(1..YYLength) );
  70.             linenum := linenum + 1;
  71.             }
  72.  
  73. ^{NAME}            {
  74.             nmstr := vstr(yytext(1..YYLength));
  75.             didadef := false;
  76.             ENTER(PICKUPDEF);
  77.             }
  78.  
  79. {SCNAME}        { nmstr := vstr(yytext(1..YYLength));
  80.               return NAME;
  81.             }
  82. ^{OPTWS}\n        { linenum := linenum + 1;
  83.               -- allows blank lines in section 1;
  84.             }
  85. {OPTWS}\n            { linenum := linenum + 1; return Newline; }
  86. .            { misc.synerr( "illegal character" );ENTER(RECOVER);}
  87.  
  88. <PICKUPDEF>{WS}        { null;
  89.               -- separates name and definition;
  90.             }
  91.  
  92. <PICKUPDEF>{NOT_WS}.*    {
  93.             nmdef := vstr(yytext(1..YYLength));
  94.  
  95.             i := tstring.len( nmdef );
  96.             while ( i >= tstring.first ) loop
  97.                 if ( (CHAR(nmdef,i) /= ' ') and
  98.                  (CHAR(nmdef,i) /= ASCII.HT) ) then
  99.                 exit;
  100.                 end if;
  101.                 i := i - 1;
  102.             end loop;
  103.  
  104.                         sym.ndinstal( nmstr,
  105.                 tstring.slice(nmdef, tstring.first, i) );
  106.             didadef := true;
  107.             }
  108.  
  109. <PICKUPDEF>\n        {
  110.             if ( not didadef ) then
  111.                 misc.synerr( "incomplete name definition" );
  112.             end if;
  113.             ENTER(0);
  114.             linenum := linenum + 1;
  115.             }
  116.  
  117. <RECOVER>.*\n        { linenum := linenum + 1;
  118.               ENTER(0);
  119.               nmstr := vstr(yytext(1..YYLength));
  120.               return NAME;
  121.             }
  122.  
  123. <SECT2PROLOG>.*\n/{NOT_WS}    {
  124.             linenum := linenum + 1;
  125.             ACTION_ECHO;
  126.             MARK_END_OF_PROLOG;
  127.             ENTER(SECT2);
  128.             }
  129.  
  130. <SECT2PROLOG>.*\n    { linenum := linenum + 1; ACTION_ECHO; }
  131.  
  132. <SECT2PROLOG><<EOF>>    { MARK_END_OF_PROLOG;
  133.               return End_Of_Input;
  134.             }
  135.  
  136. <SECT2>^{OPTWS}\n    { linenum := linenum + 1;
  137.               -- allow blank lines in sect2;}
  138.             
  139.             -- this rule matches indented lines which
  140.             -- are not comments.
  141. <SECT2>^{WS}{NOT_WS}"--".*\n    {
  142.             misc.synerr("indented code found outside of action");
  143.             linenum := linenum + 1;
  144.             }
  145.  
  146. <SECT2>"<"        { ENTER(SC); return ( '<' ); }
  147. <SECT2>^"^"        { return ( '^' ); } 
  148. <SECT2>\"        { ENTER(QUOTE); return ( '"' ); }
  149. <SECT2>"{"/[0-9]        { ENTER(NUM); return ( '{' ); }
  150. <SECT2>"{"[^0-9\n][^}\n]*    { ENTER(BRACEERROR); }
  151. <SECT2>"$"/[ \t\n]    { return ( '$' ); }
  152.  
  153. <SECT2>{WS}"|".*\n    { continued_action := true;
  154.               linenum := linenum + 1;
  155.               return Newline;
  156.             }
  157.  
  158. <SECT2>^{OPTWS}"--".*\n    { linenum := linenum + 1; ACTION_ECHO; }
  159.  
  160. <SECT2>{WS}        {
  161.             -- this rule is separate from the one below because
  162.             -- otherwise we get variable trailing context, so
  163.             -- we can't build the scanner using -{f,F}
  164.  
  165.             bracelevel := 0;
  166.             continued_action := false;
  167.             ENTER(ACTION);
  168.             return Newline;
  169.             }
  170.  
  171. <SECT2>{OPTWS}/\n    {
  172.             bracelevel := 0;
  173.             continued_action := false;
  174.             ENTER(ACTION);
  175.             return Newline;
  176.             }
  177.  
  178. <SECT2>^{OPTWS}\n    { linenum := linenum + 1; return Newline; }
  179.  
  180. <SECT2>"<<EOF>>"    { return ( EOF_OP ); }
  181.  
  182. <SECT2>^"%%".*        {
  183.             sectnum := 3;
  184.             ENTER(SECT3);
  185.             return ( End_Of_Input );
  186.             -- to stop the parser
  187.             }
  188.  
  189. <SECT2>"["([^\\\]\n]|{ESCSEQ})+"]"    {
  190.  
  191.             nmstr := vstr(yytext(1..YYLength));
  192.  
  193.             -- check to see if we've already encountered this ccl
  194.                         cclval := sym.ccllookup( nmstr );
  195.             if ( cclval /= 0 ) then
  196.                 yylval := cclval;
  197.                 cclreuse := cclreuse + 1;
  198.                 return ( PREVCCL );
  199.             else
  200.                 -- we fudge a bit.  We know that this ccl will
  201.                 -- soon be numbered as lastccl + 1 by cclinit
  202.                 sym.cclinstal( nmstr, lastccl + 1 );
  203.  
  204.                 -- push back everything but the leading bracket
  205.                 -- so the ccl can be rescanned
  206.  
  207.                 PUT_BACK_STRING(nmstr, 1);
  208.  
  209.                 ENTER(FIRSTCCL);
  210.                 return ( '[' );
  211.             end if;
  212.             }
  213.  
  214. <SECT2>"{"{NAME}"}"    {
  215.             nmstr := vstr(yytext(1..YYLength));
  216.             -- chop leading and trailing brace
  217.             tmpbuf := slice(vstr(yytext(1..YYLength)),
  218.                                 2, YYLength-1);
  219.  
  220.             nmdefptr := sym.ndlookup( tmpbuf );
  221.             if ( nmdefptr = NUL ) then
  222.                 misc.synerr( "undefined {name}" );
  223.             else
  224.                 -- push back name surrounded by ()'s
  225.                 unput(')');
  226.                 PUT_BACK_STRING(nmdefptr, 0);
  227.                 unput('(');
  228.             end if;
  229.             }
  230.  
  231. <SECT2>[/|*+?.()]    { tmpbuf := vstr(yytext(1..YYLength));
  232.               case tstring.CHAR(tmpbuf,1) is
  233.                 when '/' => return '/';
  234.                 when '|' => return '|';
  235.                 when '*' => return '*';
  236.                 when '+' => return '+';
  237.                 when '?' => return '?';
  238.                 when '.' => return '.';
  239.                 when '(' => return '(';
  240.                 when ')' => return ')';
  241.                 when others =>
  242.                     misc.aflexerror("error in aflex case");
  243.               end case;
  244.             }
  245. <SECT2>.        { tmpbuf := vstr(yytext(1..YYLength));
  246.               yylval := CHARACTER'POS(CHAR(tmpbuf,1));
  247.               return CHAR;
  248.             }
  249. <SECT2>\n        { linenum := linenum + 1; return Newline; }
  250.  
  251.  
  252. <SC>","            { return ( ',' ); }
  253. <SC>">"            { ENTER(SECT2); return ( '>' ); }
  254. <SC>">"/"^"        { ENTER(CARETISBOL); return ( '>' ); }
  255. <SC>{SCNAME}        { nmstr := vstr(yytext(1..YYLength));
  256.               return NAME;
  257.             }
  258. <SC>.            { misc.synerr( "bad start condition name" ); }
  259.  
  260. <CARETISBOL>"^"        { ENTER(SECT2); return ( '^' ); }
  261.  
  262.  
  263. <QUOTE>[^"\n]        { tmpbuf := vstr(yytext(1..YYLength));
  264.               yylval := CHARACTER'POS(CHAR(tmpbuf,1));
  265.               return CHAR;
  266.             }
  267. <QUOTE>\"        { ENTER(SECT2); return ( '"' ); }
  268.  
  269. <QUOTE>\n        {
  270.             misc.synerr( "missing quote" );
  271.             ENTER(SECT2);
  272.             linenum := linenum + 1;
  273.             return ( '"' );
  274.             }
  275.  
  276.  
  277. <FIRSTCCL>"^"/[^-\n]    { ENTER(CCL); return ( '^' ); }
  278. <FIRSTCCL>"^"/-        { return ( '^' ); }
  279. <FIRSTCCL>-        { ENTER(CCL); yylval := CHARACTER'POS('-'); return ( CHAR ); }
  280. <FIRSTCCL>.        { ENTER(CCL);
  281.               tmpbuf := vstr(yytext(1..YYLength));
  282.               yylval := CHARACTER'POS(CHAR(tmpbuf,1));
  283.               return CHAR;
  284.             }
  285.  
  286. <CCL>-/[^\]\n]        { return ( '-' ); }
  287. <CCL>[^\]\n]        { tmpbuf := vstr(yytext(1..YYLength));
  288.               yylval := CHARACTER'POS(CHAR(tmpbuf,1));
  289.               return CHAR;
  290.             }
  291. <CCL>"]"        { ENTER(SECT2); return ( ']' ); }
  292.  
  293.  
  294. <NUM>[0-9]+        {
  295.             yylval := misc.myctoi( vstr(yytext(1..YYLength)) );
  296.             return ( NUMBER );
  297.             }
  298.  
  299. <NUM>","            { return ( ',' ); }
  300. <NUM>"}"            { ENTER(SECT2); return ( '}' ); }
  301.  
  302. <NUM>.            {
  303.             misc.synerr( "bad character inside {}'s" );
  304.             ENTER(SECT2);
  305.             return ( '}' );
  306.             }
  307.  
  308. <NUM>\n            {
  309.             misc.synerr( "missing }" );
  310.             ENTER(SECT2);
  311.             linenum := linenum + 1;
  312.             return ( '}' );
  313.             }
  314.  
  315.  
  316. <BRACEERROR>"}"        { misc.synerr( "bad name in {}'s" ); ENTER(SECT2); }
  317. <BRACEERROR>\n        { misc.synerr( "missing }" );
  318.               linenum := linenum + 1;
  319.               ENTER(SECT2);
  320.             }
  321.  
  322. <ACTION>"{"        { bracelevel := bracelevel + 1; }
  323. <ACTION>"}"        { bracelevel := bracelevel - 1; }
  324. <ACTION>[^a-z_{}"'/\n]+    { ACTION_ECHO; }
  325. <ACTION>{NAME}        { ACTION_ECHO; }
  326. <ACTION>"--".*\n    { linenum := linenum + 1; ACTION_ECHO; }
  327. <ACTION>"'"([^'\\\n]|\\.)*"'"    { ACTION_ECHO;
  328.                   -- character constant;
  329.             }
  330.  
  331. <ACTION>\"        { ACTION_ECHO; ENTER(ACTION_STRING); }
  332.  
  333. <ACTION>\n        {
  334.             linenum := linenum + 1;
  335.             ACTION_ECHO;
  336.             if ( bracelevel = 0 ) then
  337.                 text_io.new_line ( temp_action_file );
  338.                 ENTER(SECT2);
  339.                     end if;
  340.             }
  341. <ACTION>.        { ACTION_ECHO; }
  342.  
  343. <ACTION_STRING>[^"\\\n]+    { ACTION_ECHO; }
  344. <ACTION_STRING>\\.    { ACTION_ECHO; }
  345. <ACTION_STRING>\n    { linenum := linenum + 1; ACTION_ECHO; }
  346. <ACTION_STRING>\"    { ACTION_ECHO; ENTER(ACTION); }
  347. <ACTION_STRING>.    { ACTION_ECHO; }
  348.  
  349.  
  350. <SECT2,QUOTE,CCL>{ESCSEQ}    {
  351.             yylval := CHARACTER'POS(misc.myesc( vstr(yytext(1..YYLength)) ));
  352.             return ( CHAR );
  353.             }
  354.  
  355. <FIRSTCCL>{ESCSEQ}    {
  356.             yylval := CHARACTER'POS(misc.myesc( vstr(yytext(1..YYLength)) ));
  357.             ENTER(CCL);
  358.             return ( CHAR );
  359.             }
  360.  
  361.  
  362. <SECT3>.*(\n?)        { if ( check_yylex_here ) then
  363.                 return End_Of_Input;
  364.               else
  365.                 ECHO;
  366.               end if;
  367.             }
  368. %%
  369.  
  370. with misc_defs, misc, sym, parse_tokens, int_io;
  371. with tstring, ascan_dfa, ascan_io, external_file_manager;
  372. use misc_defs, parse_tokens, tstring;
  373. use ascan_dfa, ascan_io, external_file_manager;
  374.  
  375. package scanner is
  376.     call_yylex : boolean := false;
  377.     function get_token return Token;
  378. end scanner;
  379.  
  380. package body scanner is
  381.  
  382. beglin : boolean := false;
  383. i, bracelevel: integer;
  384.  
  385. function get_token return Token is
  386.     toktype : Token;
  387.     didadef, indented_code : boolean;
  388.     cclval : integer;
  389.     nmdefptr : vstring;
  390.     nmdef, tmpbuf : vstring;
  391.  
  392. procedure ACTION_ECHO is
  393. begin
  394.     text_io.put( temp_action_file, yytext(1..YYLength) );
  395. end ACTION_ECHO;
  396.  
  397. procedure MARK_END_OF_PROLOG is
  398. begin
  399.      text_io.put( temp_action_file, "%%%% end of prolog" );
  400.      text_io.new_line( temp_action_file );
  401. end MARK_END_OF_PROLOG;
  402.  
  403. procedure PUT_BACK_STRING(str : vstring; start : integer) is
  404. begin
  405.     for i in reverse start+1..tstring.len(str) loop
  406.         unput( CHAR(str,i) );
  407.     end loop;
  408. end PUT_BACK_STRING;
  409.  
  410. function check_yylex_here return boolean is
  411. begin
  412.     return ( (yytext'length >= 2) and then
  413.             ((yytext(1) = '#') and (yytext(2) = '#')));
  414. end check_yylex_here;
  415.  
  416. ##
  417. begin
  418.     if (call_yylex) then
  419.         toktype := YYLex;
  420.         call_yylex := false;
  421.         return toktype;
  422.     end if;
  423.  
  424.     if ( eofseen ) then
  425.     toktype := End_Of_Input;
  426.     else
  427.     toktype := YYLex;
  428.     end if;
  429. -- this tracing code allows easy tracing of aflex runs
  430. if (trace) then
  431. text_io.new_line(Standard_Error);
  432. text_io.put(Standard_Error, "toktype = :" );
  433. text_io.put(Standard_Error, Token'image(toktype));
  434. text_io.put_line(Standard_Error, ":" );
  435. end if;
  436.  
  437.     if ( toktype = End_Of_Input ) then
  438.     eofseen := true;
  439.  
  440.     if ( sectnum = 1 ) then
  441.         misc.synerr(  "unexpected EOF" );
  442.         sectnum := 2;
  443.         toktype := SECTEND;
  444.     else
  445.         if ( sectnum = 2 ) then
  446.             sectnum := 3;
  447.             toktype := SECTEND;
  448.         end if;
  449.         end if;
  450.     end if;
  451.     
  452.     if ( trace ) then
  453.     if ( beglin ) then
  454.         int_io.put( Standard_Error, num_rules + 1 );
  455.         text_io.put( Standard_Error, ASCII.HT );
  456.         beglin := false;
  457.         end if;
  458.  
  459.     case toktype is
  460.         when '<' | '>'|'^'|'$'|'"'|'['|']'|'{'|'}'|'|'|'('|
  461.                  ')'|'-'|'/'|'?'|'.'|'*'|'+'|',' =>
  462.         text_io.put( Standard_Error, Token'image(toktype) );
  463.  
  464.         when NEWLINE =>
  465.         text_io.new_line(Standard_Error);
  466.         if ( sectnum = 2 ) then
  467.             beglin := true;
  468.                 end if;
  469.  
  470.         when SCDECL =>
  471.         text_io.put( Standard_Error, "%s" );
  472.  
  473.         when XSCDECL =>
  474.            text_io.put( Standard_Error, "%x" );
  475.  
  476.         when WHITESPACE =>
  477.                text_io.put( Standard_Error, " " );
  478.  
  479.         when SECTEND =>
  480.                text_io.put_line( Standard_Error, "%%" );       
  481.  
  482.         -- we set beglin to be true so we'll start
  483.         -- writing out numbers as we echo rules.  aflexscan() has
  484.         -- already assigned sectnum
  485.  
  486.         if ( sectnum = 2 ) then
  487.             beglin := true;
  488.                 end if;
  489.  
  490.         when NAME =>
  491.         text_io.put( Standard_Error, ''' );
  492.         text_io.put( Standard_Error, YYText);
  493.         text_io.put( Standard_Error, ''' );
  494.  
  495.         when CHAR =>
  496.             if ( (yylval < CHARACTER'POS(' ')) or
  497.              (yylval = CHARACTER'POS(ASCII.DEL)) ) then
  498.             text_io.put( Standard_Error, '\' );
  499.             int_io.put( Standard_Error, yylval );
  500.                 text_io.put( Standard_Error, '\' );
  501.         else
  502.             text_io.put( Standard_Error, Token'image(toktype) );
  503.                 end if;
  504.  
  505.         when NUMBER =>
  506.                 int_io.put( Standard_Error, yylval );
  507.  
  508.         when PREVCCL =>
  509.         text_io.put( Standard_Error, '[' );
  510.                int_io.put( Standard_Error, yylval );
  511.         text_io.put( Standard_Error, ']' );        
  512.  
  513.             when End_Of_Input =>
  514.                 text_io.put( Standard_Error, "End Marker" );
  515.  
  516.         when others =>
  517.             text_io.put( Standard_Error, "Something weird:" );
  518.         text_io.put_line( Standard_Error, Token'image(toktype));
  519.         end case;
  520.     end if;
  521.         
  522.     return toktype;
  523.  
  524. end get_token;
  525. end scanner;
  526.